home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / blas / dscal.f < prev    next >
Text File  |  1997-01-29  |  1KB  |  44 lines
  1.       subroutine  dscal(n,da,dx,incx)
  2. c
  3. c     scales a vector by a constant.
  4. c     uses unrolled loops for increment equal to one.
  5. c     jack dongarra, linpack, 3/11/78.
  6. c     modified 3/93 to return if incx .le. 0.
  7. c     modified 12/3/93, array(1) declarations changed to array(*)
  8. c
  9.       double precision da,dx(*)
  10.       integer i,incx,m,mp1,n,nincx
  11. c
  12.       if( n.le.0 .or. incx.le.0 )return
  13.       if(incx.eq.1)go to 20
  14. c
  15. c        code for increment not equal to 1
  16. c
  17.       nincx = n*incx
  18.       do 10 i = 1,nincx,incx
  19.         dx(i) = da*dx(i)
  20.    10 continue
  21.       return
  22. c
  23. c        code for increment equal to 1
  24. c
  25. c
  26. c        clean-up loop
  27. c
  28.    20 m = mod(n,5)
  29.       if( m .eq. 0 ) go to 40
  30.       do 30 i = 1,m
  31.         dx(i) = da*dx(i)
  32.    30 continue
  33.       if( n .lt. 5 ) return
  34.    40 mp1 = m + 1
  35.       do 50 i = mp1,n,5
  36.         dx(i) = da*dx(i)
  37.         dx(i + 1) = da*dx(i + 1)
  38.         dx(i + 2) = da*dx(i + 2)
  39.         dx(i + 3) = da*dx(i + 3)
  40.         dx(i + 4) = da*dx(i + 4)
  41.    50 continue
  42.       return
  43.       end
  44.